﻿<%
Class Cls_HTML
	Public Codeset              ' 页面编码类型utf-8/utf-8
	Private arrPattern          ' 替换链接规范数组
	Private vHTMLCount          ' 生成静态页数
	Private objHttp             ' HTTP对象
	Private objStream           ' Stream对象
	Private objRegExp           ' 正则对象
	Private objFSO              ' FSO组件
	Private arrReplace          ' 替换内容数组
	Private Sub Class_Initialize()
		Codeset                 = "utf-8"
		vHTMLCount              = 0
		Set objHttp = Server.CreateObject("Microsoft.XMLHTTP")
		Set objStream = Server.CreateObject("ADODB.Stream")
		Set objRegExp = New RegExp
		Set objFSO = Server.Createobject("Scripting.FileSystemObject")
	End Sub
	Private Sub Class_Terminate()
		Set objFSO = Nothing
		Set objRegExp = Nothing
		Set objStream = Nothing
		Set objHttp = Nothing
	End Sub
	
	' 返回生成页面数量
	Public Property Get HTMLCount()
		HTMLCount = vHTMLCount
	End Property
	' 添加替换规范
	Public Function AppendReplaceStr(ByVal Rxpression , ByVal Replacewith )
		Dim intUpper2
		If IsArray(arrReplace) Then
			intUpper2 = UBound(arrReplace, 2) + 1
			ReDim Preserve arrReplace(1, intUpper2)
		Else
			intUpper2 = 0
			ReDim arrReplace(1, 0)
		End If
		arrReplace(0, intUpper2) = Rxpression
		arrReplace(1, intUpper2) = Replacewith
	End Function
	Function Rand(ByVal min, ByVal max)
		Rand = Easp_Rand(min,max)
	End Function
	Function Easp_Rand(ByVal min, ByVal max)
		Randomize() : Easp_Rand = Int((max - min + 1) * Rnd + min)
	End Function
	' 添加链接替换规范
	Public Function Append(ByVal URLPattern, ByVal URLReplace)
		Dim intUpper
		If IsArray(arrPattern) Then
			intUpper = UBound(arrPattern, 2) + 1
			ReDim Preserve arrPattern(1, intUpper)
		Else
			intUpper = 0
			ReDim arrPattern(1, 0)
		End If
		arrPattern(0, intUpper) = URLPattern
		arrPattern(1, intUpper) = URLReplace
	End Function
	' 动态页面生成静态页面
	Public Function HTMLToFile(ByVal FullURL, ByVal FilePath)
		Dim strHtml             ' 页面文本
		Dim i                   ' 循环变量
		HTMLToFile = False      ' 初始化
		' 获得页面代码
		If Instr(FullURL,"?")>0 Then
			FullURL=FullURL &"&RNum=" & Rand(10000,99999)
		Else
			FullURL=FullURL & "?RNum=" & Rand(10000,99999)
		End If
		objHttp.Open "get", FullURL, False
		objHttp.setRequestHeader "CONTENT-TYPE", "text/html"
		objHttp.setRequestHeader "Charset", Codeset
		objHttp.Send()
		If objHttp.Status = 200 Then
			With objStream
				.Type = 1
				.Mode = 3
				.Open
				.Write objHttp.ResponseBody
				' 生成静态页面
				If IsArray(arrPattern) Then
					' 转换成文本格式
					.Position = 0
					.Type = 2
					.Charset = Codeset
					strHtml = .ReadText
					.Close
					.Open
					' 替换超链
					objRegExp.Global = True
					objRegExp.IgnoreCase = True
					For i = 0 to UBound(arrPattern, 2)
						objRegExp.Pattern = arrPattern(0, i)
						strHtml = objRegExp.Replace(strHtml, arrPattern(1, i))
					Next
					If IsArray(arrReplace) Then
						For i = 0 to UBound(arrReplace, 2)                         
							strHtml = Replace(strHtml, arrReplace(0, i),arrReplace(1, i))
						Next
					End If
					.WriteText strHtml
					.SaveToFile Server.Mappath(FilePath), 2
				Else
					.SaveToFile Server.Mappath(FilePath), 2
				End If
				.Close
			End With
			HTMLToFile = True
			vHTMLCount = vHTMLCount + 1
		End If
	End Function
	' 文本生成文件
	Public Function SaveToFile(ByVal Text, ByVal FilePath)
		Dim i                   ' 循环变量
		SaveToFile = False      ' 初始化
		If IsArray(arrPattern) and Text > "" Then
			' 替换超链
			objRegExp.Global = True
			objRegExp.IgnoreCase = True
			For i = 0 to UBound(arrPattern, 2)
				objRegExp.Pattern = arrPattern(0, i)
				Text = objRegExp.Replace(Text, arrPattern(1, i))
			Next
		End If
		With objStream
			.Type = 2
			.Mode = 3
			.Charset = Codeset
			.Open
			.WriteText Text
			.SaveToFile Server.Mappath(FilePath), 2
			.Close
		End With
		SaveToFile = True
		vHTMLCount = vHTMLCount + 1
	End Function
	' Folder & File function
	Public Function MD(strPath)
		On Error Resume Next
		If Not objFSO.FolderExists(Server.Mappath(strPath)) Then

			objFSO.CreateFolder Server.Mappath(strPath)
		End If
		If Err.Number = 0 Then
			MD = True
		Else
			MD = False
		End If
		On Error Goto 0
	End Function
	Public Function RD(strPath)
		On Error Resume Next
		If objFSO.FolderExists(Server.Mappath(strPath)) Then
			objFSO.DeleteFolder Server.Mappath(strPath)
		End If
		If Err.Number = 0 Then
			RD = True
		Else
			RD = False
		End If
		On Error Goto 0
	End Function
	Public Function Del(strPath)
		On Error Resume Next
		If objFSO.FileExists(Server.Mappath(strPath)) Then
			objFSO.DeleteFile Server.Mappath(strPath)
		End If
		If Err.Number = 0 Then
			Del = True
		Else
			Del = False
		End If
		On Error Goto 0
	End Function
	Public Property Get ThisServer
		Dim strServer
		Dim intPort
		intPort = Int(Request.ServerVariables("SERVER_PORT"))
		If Request.ServerVariables("HTTPS") = "on" Then
			strServer = "https://"
		Else
			strServer = "http://"
		End If
		strServer = strServer & Request.ServerVariables("SERVER_NAME")
		If intPort = 80 Or intPort = 443 Then
		Else
			strServer = strServer & ":" & intPort
		End If
		ThisServer = strServer
	End Property
End Class
%>